home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1996-07-03 | 6.4 KB | 273 lines |
- Dim STACKS(3,10),STACKP(3,2),BX(3,9),BY(3,9)
- Global STACKS(),STACKP(),BX(),BY(),Z1,Z2,B_ID,INDEX1,COMPLETE,QUIT,FINISHED
- Global MOVES,M_ON
- '
- GENERAL_SETUP
- '
- Rem **** MAIN LOOP ****
- Repeat
- INITIALISE
- DISPLAY_SETUP
- Rem *** SET GAME START VARIABLES ***
- COMPLETE=False
- FINISHED=False
- MOVES=0
- Rem *** LOOP FOR MOVES ***
- Repeat
- STRT_ZONE
- Rem *** WAIT NEEDED AS AMOS IS TO FAST! ***
- Wait 10
- DEST_ZONE
- Rem *** WAIT NEEDED AS AMOS IS TO FAST! ***
- Wait 10
- MOVES
- CHECK_COMPLETE
- Until COMPLETE or QUIT
- _CLEAR_SCREEN
- ANOTHER_GAME
- Until FINISHED
- Music Off
- System
- '
- Procedure GENERAL_SETUP
- Rem *** SETS UP SYSTEM VARIABLES THAT ARE NEEDED ONLY ONCE ***
- Screen Open 0,320,256,32,Lowres
- Wait Vbl
- Limit Mouse
- Curs Off
- Flash Off
- Unpack 6 To 0
- Double Buffer
- Wait Vbl
- M_ON=True
- Music 1
- End Proc
- Procedure INITIALISE
- '*** CLEAR THE STACKS ***
- For J=1 To 3
- For K=1 To 10
- STACKS(J,K)=0
- Next K
- Next J
- '*** SET STACK (1) START POSITIONS ***
- For J=1 To 9
- STACKS(1,J)=J
- Next J
- '*** SET STACK POINTERS ***'
- STACKP(1,1)=1
- STACKP(1,2)=1
- STACKP(2,1)=0
- STACKP(2,2)=10
- STACKP(3,1)=0
- STACKP(3,2)=10
- '*** SETUP BOB X/Y STACK CO-ORDINATES ***
- Restore X
- For J=1 To 3
- Read X
- For K=9 To 1 Step -1
- BX(J,K)=X
- Next K
- Next J
- For J=1 To 3
- Restore Y
- For K=9 To 1 Step -1
- Read Y
- BY(J,K)=Y
- Next K
- Next J
- X:
- Data 59,159,259
- Y:
- Data 207,192,177,162,147,132,117,102,87
- End Proc
- Procedure DISPLAY_SETUP
- '*** POSITION PIECES ***
- For J=1 To 9
- Bob Off J
- Next J
- For J=9 To 1 Step -1
- Bob J,BX(1,J),BY(1,J),J
- If Not M_ON Then Shoot
- Wait 10
- Next J
- '*** CLEAR WINDOWS ***
- Ink 3,3,3
- Bar 269,234 To 309,243
- '*** SET SCREEN ZONES ***
- Reserve Zone 5
- Set Zone 1,18,81 To 102,214
- Set Zone 2,118,81 To 202,214
- Set Zone 3,218,81 To 302,214
- Set Zone 4,6,19 To 40,29
- Set Zone 5,277,19 To 311,29
- End Proc
- Procedure MOVES
- Rem *** DISPLAYES MOVES TAKEN ***
- Inc MOVES
- Ink 6,3,3
- Text 270,242,Mid$((Str$(MOVES)),2,(Len(Str$(MOVES))-1))
- End Proc
- Procedure STRT_ZONE
- Rem *** CHECKS FOR VALID START SELECTION AND MUSIC ON/OFF AND QUIT ***
- GOOD_START=False
- QUIT=False
- Repeat
- Z1=Mouse Zone
- If Z1>0 and Mouse Key
- If Z1=5 or Z1=4
- If Z1=5
- If Not M_ON
- Bell 30
- End If
- QUIT=True
- Else
- If Not M_ON
- Music 1
- Else
- Music Off
- End If
- M_ON= Not M_ON
- End If
- While Mouse Key
- Wend
- Else
- B_ID=0
- INDEX1=STACKP(Z1,2)
- If INDEX1=0
- '**** EMPTY STACK ****
- If Not M_ON
- Bell 30
- Wait 5
- Bell 40
- End If
- Else
- If Not M_ON
- Bell
- End If
- B_ID=STACKP(Z1,1)
- INDEX1=STACKP(Z1,2)
- GOOD_START=True
- End If
- End If
- End If
- Until GOOD_START or QUIT=True
- End Proc
- Procedure DEST_ZONE
- Rem *** CHECKS FOR VALID DESTINATION MOVE AND MUSIC ON/OFF AND QUIT ***
- GOOD_DEST=False
- Repeat
- If QUIT=False
- Bob B_ID,X Screen(X Mouse),Y Screen(Y Mouse),B_ID
- Z2=Mouse Zone
- If Z2>0 and Mouse Key
- If Z2=5 or Z2=4
- If Z2=5
- QUIT=True
- Else
- If Not M_ON
- Music 1
- Else
- Music Off
- End If
- M_ON= Not M_ON
- End If
- While Mouse Key
- Wend
- Else
- If Z2=Z1
- If Not M_ON
- Shoot
- End If
- Bob B_ID,BX(Z1,INDEX1),BY(Z1,INDEX1),B_ID
- GOOD_DEST=True
- Else
- If STACKP(Z2,1)<B_ID and STACKP(Z2,1)<>0
- '*** DEST BOB IS SMALLER ***
- If Not M_ON
- Bell 30
- Wait 5
- Bell 40
- End If
- Else
- If Not M_ON
- Shoot
- End If
- '
- '*** UPDATE DEST STACK POINTERS ****
- STACKP(Z2,1)=B_ID
- STACKP(Z2,2)=STACKP(Z2,2)-1
- '
- '*** UPDATE DEST STACK ***
- STACKS(Z2,STACKP(Z2,2))=B_ID
- '
- '*** UPDATE SOURCE STACK ***
- STACKS(Z1,INDEX1)=0
- '
- '*** UPDATE SOURCE POINTERS ***
- STACKP(Z1,1)=STACKS(Z1,INDEX1+1)
- STACKP(Z1,2)=STACKP(Z1,2)+1
- '
- '*** PLACE BOB IN NEW POSTION ****
- Bob B_ID,BX(Z2,STACKP(Z2,2)),BY(Z2,STACKP(Z2,2)),B_ID
- '
- GOOD_DEST=True
- End If
- End If
- End If
- End If
- End If
- Until GOOD_DEST or QUIT
- End Proc
- Procedure CHECK_COMPLETE
- Rem *** SCAN STACKS TO SEE IF TOWER COMPLETED ***
- For J=2 To 3
- SUM=0
- For K=1 To 9
- SUM=STACKS(J,K)
- Next K
- If SUM=45
- STACK=J
- COMPLETE=True
- End If
- Next J
- End Proc
- Procedure _CLEAR_SCREEN
- '*** Remove counters ***
- For Q=1 To 9
- If Not M_ON
- Shoot
- End If
- Bob Off Q
- Wait 5
- Next Q
- Rem *** DISPLAY WELL DONE ***
- If COMPLETE
- Bob 11,74,52,20
- Else
- Rem *** DISPLAY GAME OVER ***
- If QUIT
- Bob 11,71,57,21
- End If
- End If
- End Proc
- Procedure ANOTHER_GAME
- Rem *** DISPLAY ANOTHER GAME PROMPT AND GET REPLY ***
- For J=1 To 3
- For K=1 To 10
- Bob K,161,185,K+9
- Wait 2
- Bob Off K
- Next K
- Next J
- Bob 1,161,185,10
- A$=""
- While A$=""
- A$=Inkey$
- A$=Upper$(A$)
- FINISHED=True
- If A$="Y"
- FINISHED=False
- Bob Off 11
- End If
- Wend
- End Proc